Shareware Grab Bag

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / pcube.bas (.txt) < prev next >

Wrap

GW-BASIC | 1982-09-21 | 24.8 KB | 443 lines

10 ' RUBIK'S CUBE SIMULATOR 20 ' PC MAGAZINE 30 ' march, 1982 40 ' karl koessel 50 SCREEN 0,1,0,0' Text mode, color on, active page, visual page 60 COLOR 7,0,1' Print white on black. Border on color monitor 70 CLS' Clear screen. Hello... 80 KEY OFF' Turn off soft keys' display on line 25 90 CLEAR,,2000' Clear some work space 100 DEFINT A-Z' Variables are all integers 110 DIM HOLD(20)' This array has subscripts greater than 10 120 GOSUB 3240' Read constants 130 GOSUB 3620' Initialize variables 140 GOSUB 3680' Display title page 150 GOSUB 3770' Input colors of faces 160 GOSUB 600' Get a new cube 170 '************************** INPUT ROUTINES ************************** 180 '*********** First input requests a twist or command 190 GOSUB 2760' Find proper location 200 COLOR 23' Blink ... 210 PRINT "Enter ";' ... beginning of input prompt 220 COLOR 7' Normal foreground 230 LINE INPUT "a twist or command: ",TWIST$' Finish prompt, no question mark 240 IF TWIST$="" THEN 190' Operator silent? Let's ask again 250 GOSUB 1860' Input received-clear input lines 260 REQ$=TWIST$' Copy input for testing routines 270 GOSUB 820' Check for a valid command, if so 280 IF D THEN 190' it's done-go back to first input 290 GOSUB 910' Else check for a valid twist 300 GOTO 190' Loop back for next twist/command 310 '********** Second input requests ok to proceed 320 GOSUB 2760' Find proper location 330 PRINT "Press [RETURN] to twist the ";' Begin second input prompt 340 IF CLRMON THEN COLOR BR(F) ELSE COLOR 1' Emphasize the ... 350 PRINT PLACE$(1,F);' ... name of the chosen face 360 COLOR 7' Normal foreground 370 PRINT " face ";' Middle of second input prompt 380 IF CLRMON THEN COLOR BR(F) ELSE COLOR 1' Emphasize the 390 PRINT DIRECTION$(OSO)' ...direction of the twist 400 COLOR 7' Normal foreground 410 IF CLRMON AND BIG THEN 430' Skip spacing? 420 PRINT SPC(13)' Print spaces on WIDTH 80 display 430 PRINT "or enter a new twist or command: ";'Finish second input prompt. 440 LINE INPUT "",GO$' Line input avoids redo error if comma is entered 450 GOSUB 1860' Input received-clear input lines 460 IF GO$="" THEN 530' If blank, go finish twist, else 470 REQ$=GO$' Copy input for testing routines 480 GOSUB 820' Check for a command, if so do it 490 ON D GOTO 320,320,320,320,510,320,320,320,530' and continue accordingly 500 GOSUB 910' else check for a valid twist 510 RETURN' Invalid 2nd input, return to 1st 520 '********** If GO$="" then finish the twist ! 530 GOSUB 2360' Finish turning outer circle 540 GOSUB 2520' Finish turning chosen face 550 GOSUB 1900' Turn off highlight flags 560 GOSUB 2000' Update `twistssofar' 570 GOSUB 1590' Print new cube 580 RETURN' Return to first input 590 '******************* NEW-ING AND HELP SEQUENCES ********************** 600 GOSUB 1900' Turn off any highlights 610 IF CLRMON THEN WIDTH 40:BIG=-1' Set to WIDTH 40. Set big flag on 620 IF NOT BIG AND D=8 THEN RETURN' HELP is already on the screen 630 GOSUB 2790' Clear screen, print instructions 640 IF D<>8 THEN GOSUB 2610' If not HELP, reinitialize cubies 650 IF NOT BIG THEN 690' WIDTH 80 display skips waiting 660 GOSUB 3020' Wait routine for WIDTH 40 670 CLS' Clear screen 680 GOSUB 3040' Print title on line 25 690 GOSUB 1290' Reprint display 700 RETURN' If NEW, return to 1st input. If HELP, return to what you were doing 710 '******************** TURN INPUT INTO UPPER CASE ******************** 720 RQ$=""' Blank new (upper case) string 730 FOR K=1 TO LEN(REQ$)' For each character of input 740 RK$=MID$(REQ$,K,1)' Set a character 750 IF RK$="'" THEN 770' If prime, skip character change 760 RK$=CHR$((ASC(RK$) AND 95))' Change to upper case character 770 RQ$=RQ$+RK$' Add character to new string 780 NEXT 790 REQ$=RQ$' Set old string to new string 800 RETURN' All uppercase, ready to check 810 '******************* TO CHECK FOR VALID COMMAND ********************** 820 GOSUB 720' Convert input to upper case 830 D=0' Valid command flag set to `no' 840 FOR DMI=1 TO 9' Check for valid command. If so, 850 IF LEFT$(REQ$,LEN(DM$(DMI)))=DM$(DMI) THEN D=DMI' ...set flag to `yes' 860 NEXT 870 IF D>0 AND D<4 THEN DM=D-1' If display type, set type flag 880 ON D GOSUB 1590,1590,1590,1380,600,1210,2040,610,1350'Do it ... 890 RETURN' ...and/or return 900 '******************* TO CHECK FOR VALID TWIST ************************ 910 GOSUB 1900' First turn off highlights that may be on 920 '********* Then check if 2nd character valid and input length =2 or less 930 IF MID$(REQ$,2,1)=""OR MID$(REQ$,2,1)="'"AND LEN(REQ$)<3 THEN 960 940 GOTO 1020' Invalid input 950 '********* Check first character of input for a valid twist 960 F=0' Deselect face 970 FOR W=1 TO LEN(T$)' If twist is valid, set F to face number... 980 IF LEFT$(REQ$,1)=MID$(T$,W,1) THEN F=W:TWIST$=REQ$' ...and reset TWIST$ 990 NEXT 1000 IF F THEN 1100' If face valid, go to prepare for 2nd input 1010 '********* Invalid input! 1020 GOSUB 2760' Locate prompt line, print message 1030 PRINT "Input ";:COLOR 23:PRINT "NOT";:COLOR 7:PRINT " recognized" 1040 PRINT " One moment please..." 1050 GOSUB 1590' Reprint display without highlights 1060 GOSUB 1860' Clear input prompt lines 1070 RETURN' Restart input 1080 '******************** PREPARE THE SELECTED TWIST ********************* 1090 '********* Find direction, set offsets for inner & outer circular arrays 1100 IF MID$(REQ$,2,1)="'" THEN OSO=2:OSI=1 ELSE OSO=0:OSI=5 1110 '********* Then, for the outer circle ... 1120 GOSUB 2200' Decode array pointers 1130 GOSUB 2260' Set holding cells, turn highlight flags on 1140 '********** Then for the chosen face, 1150 GOSUB 2460' Set holding cells, turn highlight flags on 1160 '********** Preparation done ... 1170 IF SKIP THEN 530' If SKIP, no 2nd input, go finish twist now 1180 GOSUB 1590' Reprint display with highlights 1190 GOTO 320' Go to second input 1200 '******************** THOSE USING COLOR CAN CHANGE WIDTH ************ 1210 IF NOT CLRMON THEN 1330' This routine is for color monitors only 1220 BIG=NOT BIG' Reverse big flag. -1=WIDTH 40, 0=WIDTH 80 1230 IF BIG THEN WIDTH 40:GOTO 1260' Make the change to WIDTH 40, skip to 1260 1240 WIDTH 80' Make the change to WIDTH 80 1250 GOSUB 2790' For WIDTH 80, print instructions 1260 GOSUB 1290' Display reprinting routine 1270 RETURN' Continue with what you were doing before 1280 '******************** DISPLAY REPRINTING ROUTINE ******************* 1290 IF BIG THEN GOSUB 3060' Input list for WIDTH 40 display 1300 GOSUB 1390' Reprint labels or blanks without changing flag 1310 GOSUB 1590' Reprint the cube in the new width 1320 IF NOT BIG THEN GOSUB 2040' Reprint twists so far without adding a twist 1330 RETURN' Return to input 1340 '******************** REVERSE SKIP FLAG *************************** 1350 SKIP=NOT SKIP' -1=SKIP ON, 0=SKIP OFF. When on, program skips 1360 RETURN' second input (request to proceed) 1370 '******************** LABELS ON/OFF ROUTINE ************************ 1380 LABEL = NOT LABEL' Reverse label flag. -1=LABELS ON, 0=LABELS OFF 1390 FOR FA=1 TO 6' For each face 1400 IF BIG THEN LOCATE XBL(FA),YBL(FA):GOTO 1420' Locate for WIDTH 40 or 1410 LOCATE X(FA)+2,Y(FA)-1' Locate under each face & 1420 IF NOT LABEL GOTO 1460' If labels are wanted off 1430 IF CLRMON THEN COLOR BR(FA) ELSE COLOR 1' Emphasize (face's color) 1440 PRINT PLACE$(1,FA);' Print name of face 1450 GOTO 1470' Otherwise... 1460 PRINT SPC(5);' Print blanks over label 1470 NEXT 1480 IF NOT BIG THEN 1570' WIDTH 80 display is done 1490 FOR XBL=1 TO 2' `Front' face has pointer 1500 LOCATE XBL+4,19-XBL' between face and label 1510 IF NOT LABEL THEN GOTO 1540' If labels are wanted off 1520 COLOR BR(3)' Color of front face 1530 PRINT "/";' Make pointer of slashes 1540 PRINT " "' or blank out the slashes 1550 NEXT 1560 COLOR 7' Normal foreground 1570 RETURN' To what you were doing 1580 '************************ CUBE PRINTING ROUTINE ******************** 1590 DB=1:DUB=0' Initialize display formatting variables 1600 IF BIG THEN DB=2' Double this variable for WIDTH 40 1610 FOR FA=1 TO 6' For each face 1620 FOR P=0 TO 8' For each cubie on this face 1630 IF BIG THEN FOR DUB=0 TO 1' To square cubie WIDTH 40 prints 2 lines 1640 LOCATE X(FA)+XOF(P)*DB+DUB-REL(FA)*BIG,Y(FA)+YOF(P)+RELY(FA)*BIG'Where 1650 BR=BR(FIX(CUBIE(FA,P,1)\10))' Set background color 1660 IF BR THEN COLOR CUBIE(FA,P,2)*-16,BR:GOTO 1680' Blink foreground? 1670 IF CUBIE(FA,P,2) THEN COLOR 0,7 ELSE COLOR 7,0' Turn on highlights? 1680 IF DUB THEN PRINT " ";:GOTO 1710' Bottom half of cubie 1690 IF DM THEN PRINT USING "\\"; CUBIE$(FA,P,DM); ELSE PRINT USING "##"; CUBIE(FA,P,1);' Print proper type cubie 1700 '****************** These lines tidy display as colors/highlights change 1710 ON P+1 GOTO 1730,1720,1720,1800,1800,1800,1740,1740,1730' Nine cubies 1720 ND=1:GOTO 1760' Set the `NextDoor' variable for 1730 ND=4:GOTO 1760' six of them so following lines 1740 ND=-1:GOTO 1760' can compare neighboring cubies 1750 ' Find proper colors for each side of spaces between cubies 1760 IF BR THEN COLOR BR,BR(FIX(CUBIE(FA,(P+ND) MOD 12,1)\10)) ELSE 1780 1770 PRINT CHR$(221);:GOTO 1800' Left half one color, right half another 1780 IF CUBIE(FA,P,2)=CUBIE(FA,(P+ND) MOD 12,2) THEN 1790 ELSE COLOR 7,0 1790 PRINT " ";' Single space lit or not, for monochrome 1800 IF BIG THEN NEXT' WIDTH 40 prints 2 lines to square cubie 1810 NEXT 1820 NEXT 1830 COLOR 7,0' Normalize foreground, background 1840 RETURN 1850 '************************ CLEAR PROMPT/INPUT LINES ***************** 1860 GOSUB 2760' Find proper location (differs on WIDTH 40) 1870 PRINT "One moment, please..."SPC(79)SPC(39)SPC(21)' Clears lines 15 & 16 1880 RETURN' If WIDTH 40 clears line 19, 20 & 21 1890 '************************ TURN OFF HIGHLIGHT FLAGS ***************** 1900 FOR J=1 TO 4' Four faces touch the chosen face and have ... 1910 FOR K=1 TO 3' Three consecutive cubies touching chosen face 1920 CUBIE(FACE(J),((POSITION(J)+K-2) MOD 8)+1,2)=0' Turn highlight... 1930 NEXT' ...flags `off' 1940 NEXT 1950 FOR P=1 TO 8' All cubies on chosen face except the center 1960 CUBIE(F,P,2)=0' Turn highlight flags `off' 1970 NEXT 1980 RETURN 1990 '************************ KEEP TRACK OF TWISTS ********************* 2000 TWISTSSOFAR$(AT)=TWISTSSOFAR$(AT)+TWIST$+" "' Add valid twist to records 2010 IF LEN(TWISTSSOFAR$(AT))>36 THEN AT=AT+1' Keeps 2 letter twists on 1 line 2020 IF BIG THEN RETURN' WIDTH 40 doesn't print new list 2030 '************************ PRINT LIST OF TWISTS SO FAR ************** 2040 LOCATE 18,1' Begin at bottom third of screen 2050 IF BIG THEN PRINT' Down 1 more line for WIDTH 40 2060 COLOR 1' Emphasize list of twists header 2070 PRINT TWISTSSOFAR$(0);' Print header 2080 COLOR 7' Normal foreground 2090 PRINT SPC(13)' Put space between header & list 2100 FOR K=1 TO AT' For each half line of twists 2110 PRINT TWISTSSOFAR$(K);' Print 1st half line. If not big 2120 IF NOT BIG THEN PRINT TWISTSSOFAR$(K+1);:K=K+1' Print 2nd half line 2130 PRINT' Linefeed before end of WIDTH 2140 NEXT 2150 IF NOT BIG THEN RETURN' If WIDTH 80, all done, return 2160 GOSUB 3020' For WIDTH 40, wait to continue, 2170 GOSUB 1860' clear input prompt lines, 2180 RETURN' then return 2190 '************************ DECODE ARRAY POINTERS FOR OUTER CIRCLE *** 2200 FOR J=1 TO 4' Four faces touch any chosen face 2210 FACE(J)=VAL(MID$(OC$(F),J*2-1,1))' Which four? Also, from each, the 2220 POSITION(J)=VAL(MID$(OC$(F),J*2,1))' first of the three consecutive 2230 NEXT' cubies closest to a chosen face 2240 RETURN 2250 '************************ PREPARE TO TURN OUTER CIRCLE ************* 2260 FOR J=1 TO 4' Four faces touch chosen face... 2270 FOR K=1 TO 3' ...with three consecutive cubies 2280 ' Set cubie value in holding cell 2290 HOLD((J-1)*3+K)=CUBIE(FACE(J),((POSITION(J)+K-2) MOD 8)+1,1) 2300 ' Turn highlight flags `on' 2310 CUBIE(FACE(J),((POSITION(J)+K-2) MOD 8)+1,2)=-1 2320 NEXT 2330 NEXT 2340 RETURN 2350 '************************ FINISH TURNING OUTER CIRCLE ************** 2360 FOR J=1 TO 4' Four faces touch chosen face... 2370 FOR K=1 TO 3' ...with three consecutive cubies 2380 CUBIE(FACE(((J+OSO) MOD 4)+1),((POSITION(((J+OSO) MOD 4)+1)+K-2) MOD 8)+1,1)=HOLD((J-1)*3+K)' New value of each cubie 2390 FOR DMI=1 TO 2' Associated names follow 2400 CUBIE$(FACE(((J+OSO) MOD 4)+1),((POSITION(((J+OSO) MOD 4)+1) +K-2) MOD 8)+1,DMI)=PLACE$(DMI,FIX((HOLD((J-1)*3+K)\10))) 2410 NEXT 2420 NEXT 2430 NEXT 2440 RETURN 2450 '************************ PREPARE TO TURN CHOSEN FACE ************** 2460 FOR P=1 TO 8' All cubies on chosen face except the center 2470 HOLD(12+P)=CUBIE(F,P,1)' Put cubie value in holding cell 2480 CUBIE(F,P,2)=-1' Turn highlight flags `on' 2490 NEXT 2500 RETURN 2510 '************************ FINISH TURNING CHOSEN FACE **************** 2520 FOR P=1 TO 8' All cubies on chosen face except the center 2530 CUBIE(F,P,1)=HOLD(13+((P+OSI)MOD 8))' New value of each cubie 2540 FOR DMI=1 TO 2' Associated names follow 2550 CUBIE$(F,P,DMI)=PLACE$(DMI,FIX(CUBIE(F,P,1)\10)) 2560 NEXT 2570 NEXT 2580 RETURN 2590 '************************ SET UP FRESH CUBE ************************* 2600 'Initialize cubie arrays to starting values 2610 FOR F = 1 TO 6' Six faces on the cube 2620 FOR P = 0 TO 9' Nine cubies per face 2630 CUBIE(F,P,1)=F*10+P' Two digit code 2640 FOR DMI=1 TO 2' Associated face and color 2650 CUBIE$(F,P,DMI)=LEFT$(PLACE$(DMI,F),2) 2660 NEXT 2670 NEXT 2680 NEXT 2690 'Erase accumulated `twists so far' 2700 FOR K=1 TO AT 2710 TWISTSSOFAR$(K)=""' Erase each line 2720 NEXT 2730 AT=1' Begin line index at 1 2740 RETURN 2750 '************************ WIDTH 40 PROMPT LINE RELOCATER ************ 2760 IF BIG THEN LOCATE 19,1 ELSE LOCATE 15,1' Location of input prompt 2770 RETURN 2780 '************************ CLEAR SCREEN, PRINT INSTRUCTIONS ********** 2790 IF BIG THEN COLOR ,4:BG=3 ELSE BG=43' Set background color, offsets 2800 CLS' Clear screen 2810 LOCATE 1,1+BG:COLOR 1:PRINT TITLE$' Use emphasis where needed 2820 LOCATE 3,3+BG:COLOR 7:PRINT"Each twist is called by the first" 2830 LOCATE 4,BG:PRINT"letter of the face you wish to twist:" 2840 LOCATE 5,BG:COLOR 1:PRINT"U";:COLOR 7:PRINT" for the upper face, "; :COLOR 1:PRINT"L";:COLOR 7:PRINT" for the left" 2850 LOCATE 6,BG:PRINT"face, ";:COLOR 1:PRINT"F";:COLOR 7: :PRINT" for the front face, ";:COLOR 1:PRINT"R";:COLOR 7:PRINT" for the" 2860 LOCATE 7,BG:PRINT"right face, ";:COLOR 1:PRINT"B";:COLOR 7 :PRINT" for the back face and ";:COLOR 1:PRINT"D":COLOR 7 2870 LOCATE 8,BG:PRINT"for the downward face. The twists will" 2880 LOCATE 9,BG:PRINT"be clockwise. To make a counterclock-" 2890 LOCATE 10,BG:PRINT"wise twist, the letter is followed by" 2900 LOCATE 11,BG:PRINT"a ";:COLOR 1:PRINT"'";:COLOR 7:PRINT" (e.g. "; :COLOR 1:PRINT"L'";:COLOR 7:PRINT" ). To change the display," 2910 LOCATE 12,BG:PRINT"enter either the word ";:COLOR 1:PRINT"Labels"; :COLOR 7:PRINT" or ";:COLOR 1:PRINT"Colors";:COLOR 7 2920 IF CLRMON THEN LOCATE 12,BG:PRINT"enter the word ";:COLOR 1:PRINT "Big";: COLOR 7:PRINT" or ";' Additional command for color monitors 2930 LOCATE 13,BG:PRINT"or ";:COLOR 1:PRINT"Faces";:COLOR 7:PRINT" or "; :COLOR 1:PRINT"Codes";:COLOR 7:PRINT". Use ";:COLOR 1:PRINT"Skip";:COLOR 7 :PRINT" to resume/" 2940 LOCATE 14,BG:PRINT"skip verification. Use ";:COLOR 1:PRINT"New";:COLOR 7 :PRINT" to restart." 2950 IF NOT BIG THEN RETURN' The following commands are for WIDTH 40 2960 LOCATE 15,3:PRINT "To accommodate those using television "; 2970 PRINT " sets (i.e. confined to WIDTH 40), the "; 2980 PRINT " commands ";:COLOR 1:PRINT "List";:COLOR 7:PRINT " & ";:COLOR 1 2990 PRINT "Help";:COLOR 7:PRINT " have been added." 3000 RETURN 3010 '************************ WAIT TO CONTINUE ************************** 3020 LOCATE 25,9:PRINT "Press the spacebar to continue"; 3030 IF INKEY$<>" " THEN 3030 3040 LOCATE 25,3:COLOR 1,4:PRINT TITLE$;:COLOR 7,0:RETURN 3050 '************************ WIDTH 40 INPUT LIST ********************** 3060 LOCATE 1,19:COLOR BR(2),,BR(4):PRINT "Twists: "; 3070 FOR LI=1 TO 2:LOCATE LI,25+LI 3080 FOR TI=1 TO 3 3090 FOR DI=0 TO 1 3100 COLOR BR((LI-1)*3+TI) 3110 IF DI THEN PU$="!' " ELSE PU$="! " 3120 PRINT USING PU$;MID$(T$,(LI-1)*3+TI); 3130 NEXT 3140 NEXT 3150 NEXT 3160 LOCATE 4,31:COLOR BR(6):PRINT "Commands:"; 3170 FOR CM=1 TO 9 3180 LOCATE 5+CM,35 3190 COLOR BR(CM MOD 6+1) 3200 PRINT DM$(CM) 3210 NEXT 3220 COLOR 7:RETURN 3230 '************************ READ CONSTANTS *************************** 3240 FOR FACE=1 TO 6' Six faces 3250 READ PLACE$(1,FACE)' Name and number each face 3260 NEXT 3270 DATA"upper","left","front","right","back","down" 3280 FOR FACE=1 TO 6' If you have a cube that's used frequently, 3290 READ YOURS$(FACE)' put the six names of its colors as data on 3300 NEXT' line 3310 in proper (see line 3270) order. See REMark on line 4160 3310 DATA"white","orange","blue","red","green","yellow" 3320 FOR P=1 TO 8' Eight cubies surround the center cubie 3330 READ XOF(P),YOF(P)' Offsets to locations of middle cubies for 3340 NEXT' each neighboring cubie on the same face 3350 DATA -1,-3,-1,0,-1,3,0,3,1,3,1,0,1,-3,0,-3 3360 FOR FA=1 TO 6' Six faces 3370 READ XBL(FA),YBL(FA)' Locations of labels in WIDTH 40 mode 3380 NEXT 3390 DATA 2,4,13,3,4,19,13,19,13,27,17,17 3400 FOR FA=1 TO 6' Six faces 3410 READ REL(FA),RELY(FA)' Offsets from old to new locations of the 3420 NEXT' middle cubies of each face 3430 DATA 1,2,3,0,3,2,3,4,3,6,5,2 3440 FOR F=1 TO 6' Six faces 3450 READ X(F),Y(F)' Locations of middle cubies of each face 3460 NEXT 3470 DATA 2,14,6,4,6,14,6,24,6,34,10,14 3480 FOR F=1 TO 6' Six faces 3490 READ OC$(F)' Codes with array indexes to outer circle around each face 3500 NEXT 3510 DATA "21514131","17376753","15476123","13576333","11276543","25354555" 3520 FOR DMI=1 TO 9' Nine recognized commands 3530 READ DM$(DMI)' Valid display types and other commands 3540 NEXT 3550 DATA CODE,FACE,COLOR,LABEL,NEW,BIG,LIST,HELP,SKIP 3560 DIRECTION$(0)="clockwise":DIRECTION$(2)="counterclockwise" 3570 T$="ULFRBD"' Valid twist requests 3580 TWISTSSOFAR$(0)="The list of twists so far :" 3590 TITLE$=SPACE$(7)+"RUBIK'S CUBE SIMULATOR"+SPACE$(7) 3600 RETURN 3610 '************************ INITIALIZE VARIABLES ********************* 3620 DEF SEG=0' Is color monitor present? 3630 IF (PEEK(&H410) AND &H30)<>&H30 THEN CLRMON=-1' If so, set CLRMON flag on 3640 DM=1' Set display type for faces 3650 LABEL=-1' Turn label flag on 3660 RETURN 3670 '************************ TITLE PAGE ******************************* 3680 IF CLRMON THEN COLOR 1,4:WIDTH 40:K=1 ELSE WIDTH 80:K=21 3690 CLS:LOCATE 3,2+K:PRINT TITLE$ 3700 LOCATE 6,15+K:PRINT"PC MAGAZINE" 3710 LOCATE ,15+K:COLOR 7:PRINT"March, 1982" 3720 LOCATE 24,19+K:PRINT"press the spacebar"; 3730 IF INKEY$<>" " THEN 3730 3740 COLOR 7,0 3750 RETURN 3760 '************************ INPUT A COLOR FOR EACH FACE ************** 3770 CLS 3780 LOCATE 2,7+K 3790 K$="*** COLORING THE CUBE ***" 3800 'Is color monitor present? 3810 IF CLRMON THEN 3880 3820 'For those using a monochrome monitor 3830 PRINT K$ 3840 LOCATE 9,K+6 3850 PRINT"(The name of each color":PRINT SPC(11+K)"should begin with a": 3860 PRINT SPC(16+K)"different letter.)":GOTO 4080 3870 'For those using a color monitor 3880 FOR L=1 TO 25 3890 COLOR (L MOD 7)+1 3900 PRINT MID$(K$,L,1); 3910 NEXT 3920 LOCATE 4,4 3930 FOR C=1 TO 7' Print a block of color and it's assigned number 3940 COLOR ,C 3950 PRINT " "; 3960 COLOR C,0 3970 PRINT "---";C; 3980 PRINT SPC(10) 3990 NEXT 4000 LOCATE 9,1' Print coloring directions 4010 COLOR 1,4 4020 PRINT "Choose each face's color by entering the"; 4030 PRINT "appropriate number from the list above, "; 4040 COLOR 0,2 4050 PRINT "or just press [RETURN] for each face and"; 4060 PRINT "the computer will choose the colors. " 4070 'For everybody 4080 LOCATE 15,K 4090 COLOR 23,0:PRINT"Enter"; 4100 COLOR 7:PRINT" a color for each face:" 4110 PRINT 4120 FOR FACE = 1 TO 6 4130 LOCATE FACE+16,15+K:COLOR 0,7:PRINT USING" \ \";PLACE$(1,FACE); 4140 COLOR 7,0:INPUT;" ";PLACE$(2,FACE)' Semicolon before input prompt... 4150 IF CLRMON THEN 4190' ...suppresses the usual linefeed 4160 IF PLACE$(2,FACE)="" THEN PLACE$(2,FACE)=YOURS$(FACE)'See REMarks from lines 3280-3300 to name colors by default (null input) for frequently used cube 4170 GOTO 4240 4180 'Again, for those using color 4190 IF PLACE$(2,FACE)="" THEN BR(FACE)=FACE:GOTO 4220 ELSE BR(FACE)=VAL(PLACE$(2,FACE)) 4200 IF BR(FACE)<1 OR BR(FACE)>7 THEN LOCATE ,26:PRINT SPC(14):GOTO 4130 4210 IF ASC(PLACE$(2,FACE))<56 THEN PLACE$(2,FACE)=MID$(PLACE$(2,FACE),2) 4220 COLOR 7,0:LOCATE ,24:PRINT "= ";' Print `=' over question mark 4230 COLOR 0,BR(FACE):PRINT PLACE$(2,FACE)+" " 'Print name and block of 4240 NEXT' selected color 4250 'And finally, again for everybody 4260 COLOR 7,0' Normalize color and 4270 LOCATE 15,K:PRINT "*Chosen ";' Write over blinking prompt 4280 LOCATE 9,K' This writes over coloring directions 4290 COLOR 1,4 4300 PRINT " Check each face and its chosen color. "; 4310 COLOR 7,0 4320 PRINT SPC(79)" "; 4330 LOCATE 11,K 4340 COLOR 5,2 4350 PRINT "Press the spacebar to start over... or,"; 4360 COLOR ,0 4370 PRINT SPC(79)" "; 4380 LOCATE 99ation 200 COLOR 23' Blink ... 210 PRINT "Enter ";' ... beginning of input prompt 220 COLOR 7' Normal foreground 230 LINE INPUT "a twist or command: ",TWIST$' Finish prom